home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / simage / bmpview1.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  6KB  |  234 lines
  1. unit Bmpview1;
  2.  
  3. interface
  4.  
  5. uses 
  6.   WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, 
  7.   dialogs, ExtCtrls, 
  8.   StdCtrls, sysutils, FileCtrl, Grids, Outline, DirOutln, Simage;
  9.  
  10. type
  11.   TViewer = class(TForm)
  12.     ImageLabel: TLabel;
  13.     FileList: TFileListBox;
  14.     DriveBox: TDriveComboBox;
  15.     TreeLabel: TLabel;
  16.     DriveLabel: TLabel;
  17.     tree: TDirectoryOutline;
  18.     RadioGroup1: TRadioGroup;
  19.     GroupBox1: TGroupBox;
  20.     CropBtn: TButton;
  21.     CancelCropBtn: TButton;
  22.     ShowCropped: TRadioButton;
  23.     ShowFull: TRadioButton;
  24.     ShowFitted: TRadioButton;
  25.     ShowActual: TRadioButton;
  26.     BitBtn1: TBitBtn;
  27.     ScrollBox1: TScrollBox;
  28.     Panel1: TPanel;
  29.     image: TSimage;
  30.     procedure FileListClick(Sender: TObject);
  31.     procedure DriveBoxChange(Sender: TObject);
  32.     procedure treeChange(Sender: TObject);
  33.     procedure ImageClick(Sender: TObject);
  34.     procedure OptionsClick(Sender: TObject);
  35.     procedure CancelCropBtnClick(Sender: TObject);
  36.     procedure CropBtnClick(Sender: TObject);
  37.     procedure FormResize(Sender: TObject);
  38.   private
  39.   { Private declarations }
  40.     procedure loadimage(
  41.                      fname : string);
  42.     procedure SetOptions(
  43.                      OnOff : boolean);
  44.   private
  45.     CropTool : boolean;
  46.     cur_rect : Trect;
  47.     orgheight,
  48.     orgwidth,
  49.     oldheight,
  50.     oldwidth : integer;
  51.   end;
  52.  
  53. var
  54.   Viewer: TViewer;
  55.  
  56. implementation
  57. uses
  58.   fullscr;
  59.  
  60. {$R *.DFM}
  61.  
  62. {-------------------------------------------------------------------------}
  63. procedure TViewer.FileListClick(Sender: TObject);
  64. begin
  65.   if croptool then
  66.     CancelCropBtnClick(Sender);
  67.   with filelist do   
  68.     if filename <> '' then LoadImage(filename);
  69. end;
  70.  
  71. {-------------------------------------------------------------------------}
  72. procedure TViewer.DriveBoxChange(Sender: TObject);
  73. var
  74.   SaveCursor : HCursor;
  75. begin
  76.   SaveCursor := screen.cursor;
  77.   screen.cursor := crHourGlass;
  78.   tree.drive := drivebox.drive;
  79.   screen.cursor := SaveCursor;
  80. end;
  81.  
  82. {-------------------------------------------------------------------------}
  83. procedure TViewer.treeChange(Sender: TObject);
  84. var
  85.   SaveCursor : HCursor;
  86. begin
  87.   SaveCursor := screen.cursor;
  88.   screen.cursor := crHourGlass;
  89.   LoadImage('');
  90.   with FileList do
  91.   begin
  92.     directory := tree.directory;
  93.     if items.count > 0 then
  94.     begin
  95.       itemindex := 0;
  96.       FileListClick(Sender);
  97.     end;
  98.   end;
  99.   screen.cursor := SaveCursor;
  100. end;
  101.  
  102. {-------------------------------------------------------------------------}
  103. procedure TViewer.loadimage(
  104.                         fname : string);
  105. begin
  106.   with image do
  107.     if get_filename <> fname then
  108.     begin
  109.       CropBtn.enabled := yes;
  110.       cur_rect := rect(0,0,0,0);
  111.       changefromfile(fname,cur_rect,no,ShowActual.checked);
  112.     end;
  113. end;
  114.  
  115. {-------------------------------------------------------------------------}
  116. procedure TViewer.ImageClick(Sender: TObject);
  117. begin
  118.   FullSlide.Image.ReplaceWith(TSimage(Sender),rect(0,0,0,0),no,no);
  119.   FullSlide.showmodal;
  120. end;
  121.  
  122. {-------------------------------------------------------------------------}
  123. procedure TViewer.SetOptions(
  124.                      OnOff : boolean);
  125. begin
  126.   ShowCropped.enabled := OnOff;
  127.   ShowActual.enabled  := OnOff;
  128.   ShowFull.enabled    := OnOff;
  129.   ShowFitted.enabled  := OnOff;
  130. end;
  131.  
  132. {-------------------------------------------------------------------------}
  133. procedure TViewer.OptionsClick(Sender: TObject);
  134. begin
  135.   Image.Redraw(cur_rect,ShowCropped.Checked,ShowActual.checked);
  136.   Filelist.SetFocus;
  137. end;
  138.  
  139. {-------------------------------------------------------------------------}
  140. procedure TViewer.CropBtnClick(Sender: TObject);
  141. var
  142.   changed : boolean;
  143. begin
  144.   with image do
  145.     if croptool then
  146.     begin
  147.       croptool_off(changed,cur_rect);
  148.       CropBtn.caption := 'Activate Crop &Tool';
  149.       CancelCropBtn.enabled := no;
  150.       SetOptions(yes);
  151.       if ShowCropped.Checked then
  152.         Redraw(cur_rect,yes,ShowActual.checked);
  153.     end
  154.     else
  155.     begin
  156.       if ShowCropped.Checked then
  157.         Redraw(cur_rect,no,ShowActual.checked);
  158.       croptool_on;
  159.       CropBtn.caption := 'Save Crop Settings';
  160.       CancelCropBtn.enabled := yes;
  161.       SetOptions(no);
  162.     end;                           
  163.   croptool := not croptool;
  164. end;
  165.  
  166. {-------------------------------------------------------------------------}
  167. procedure TViewer.CancelCropBtnClick(Sender: TObject);
  168. var
  169.   changed : boolean;
  170.   rect : Trect;
  171. begin
  172.   with image do
  173.     if croptool then
  174.     begin
  175.       croptool_off(changed,rect);
  176.       CropBtn.caption := 'Activate Crop &Tool';
  177.       CancelCropBtn.enabled := no;
  178.       SetOptions(Yes);
  179.       if ShowCropped.Checked then
  180.         Redraw(cur_rect,yes,ShowActual.checked);
  181.     end;
  182.   croptool := no;
  183. end;
  184.  
  185. {-------------------------------------------------------------------------}
  186. procedure TViewer.FormResize(Sender: TObject);
  187. var
  188.   resizeimage : boolean;
  189.   t,l,w,h,
  190.   h_delta,
  191.   w_delta : integer;
  192. begin
  193.   if oldheight = 0 then                                     {original call}
  194.   begin
  195.     orgheight := height;
  196.     oldheight := height;
  197.     orgwidth  := width;
  198.     oldwidth  := width;
  199.   end
  200.   else
  201.   begin
  202.     resizeimage := no;
  203.     if height >= orgheight then
  204.       h_delta := (height - oldheight)
  205.     else
  206.       h_delta := (orgheight - oldheight);
  207.     if h_delta <> 0 then
  208.     begin
  209.       ScrollBox1.height := ScrollBox1.height + h_delta;
  210.       inc(oldheight,h_delta);
  211.       resizeimage := yes;
  212.     end;
  213.     if width >= orgwidth then
  214.       w_delta := (width - oldwidth)
  215.     else
  216.       w_delta := (orgwidth - oldwidth);
  217.     if w_delta <> 0 then
  218.     begin                    
  219.       ScrollBox1.width := ScrollBox1.width + w_delta;
  220.       inc(oldwidth,w_delta);
  221.       resizeimage := yes;
  222.     end;
  223.     if resizeimage then
  224.       with image do
  225.       begin
  226.         GetDesignedSize(t,l,w,h);
  227.         SetDesignedSize(t,l,w + w_delta,h + h_delta);
  228.         Redraw(cur_rect,ShowCropped.Checked,ShowActual.checked);
  229.       end;
  230.   end;
  231. end;
  232.  
  233. end.
  234.